home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / math.swg / 0082_Triangular Fractal.pas < prev    next >
Pascal/Delphi Source File  |  1994-11-30  |  3KB  |  128 lines
  1. program Chaos;
  2.  
  3. {Triangular fractal generator
  4.  
  5.  Based on program "Chaos" published in Nibble, June 1989 (Vol. 10, No. 6)
  6.  One-Liner winner written by Max Raymond of Huston, TX.  Program inspired
  7.  by a PBS broadcast of Nova, called "Chaos".
  8.  
  9.  Adapted for Turbo Pascal by Scott Earnest, 1994.
  10.  scott@whiplash.pc.cc.cmu.edu
  11.  
  12.  About the program:
  13.  
  14.  When the program is run, it will ask for 4 sets of coordinates.  The first
  15.  three are the vertices of the triangle, and the fourth is the location of
  16.  the "traveler", the point that moves around the screen leaving its path.
  17.  The traveler may start at any position either inside or outside the tri-
  18.  angle.  Press any key to exit the program.
  19.  
  20.  The original author's comment about the program:
  21.  
  22.    "A three-sided die is simulated, and its roll corresponds to one of
  23.     the three vertices of the triangle.  The traveler will move halfway
  24.     from its current point toward the vertex selected by the die roll.
  25.     A copy of the traveler is left behind at its old position, while
  26.     the traveler is redrawn at its new position.  The process is then
  27.     repeated.  The pattern that emerges is a record of the traveler's
  28.     journey, as it jumps from point to point."
  29.  
  30. }
  31.  
  32. uses graph, crt;
  33.  
  34. const BGIPath : string[80] = 'E:\BP\BGI';
  35.  
  36. type
  37.   TPoint = record
  38.     x, y : integer;
  39.   end;
  40.  
  41. var
  42.   grDriver,
  43.   grMode,
  44.   grError : integer;
  45.  
  46.   MaxX, MaxY : word;
  47.  
  48.   TriExt : array [1 .. 4] of TPoint;
  49.  
  50. procedure StartGraph;
  51.  
  52. begin
  53.   grDriver := Detect;
  54.   initgraph (grDriver, grMode, BGIPath);
  55.   grError := GraphResult;
  56.   if grError <> grOk then
  57.   begin
  58.     writeln ('Graphics error:  ', GraphErrorMsg(grError));
  59.     halt (1);
  60.   end;
  61.   MaxX := getmaxx;
  62.   MaxY := getmaxy;
  63. end;
  64.  
  65. procedure InputPoints;
  66.  
  67. var
  68.   pnum : byte;
  69.   tx, ty : word;
  70.  
  71.   function inputnum (idx : byte; max : word; ch : char) : word;
  72.  
  73.   var
  74.     inval, err : word;
  75.     instr : string;
  76.  
  77.   begin
  78.     repeat
  79.       if idx < 4 then
  80.         write ('Enter ',ch,' vertex #',idx,':  ')
  81.       else
  82.         write ('Enter "traveler" start ',ch,':  ');
  83.       readln (instr);
  84.       val (instr, inval, err);
  85.       if (err > 0) or (inval > max) then
  86.         writeln ('Invalid entry.  Please re-enter.');
  87.     until (inval <= Max);
  88.     inputnum := inval;
  89.   end;
  90.  
  91. begin
  92.   writeln ('Screen range = X:(0-',MaxX,'); Y:(0-',MaxY,').');
  93.   for pnum := 1 to 4 do
  94.     begin
  95.       TriExt[pnum].x := inputnum (pnum, MaxX, 'X');
  96.       TriExt[pnum].y := inputnum (pnum, MaxY, 'Y');
  97.     end;
  98. end;
  99.  
  100. procedure DrawChaos;
  101.  
  102. var
  103.   select : byte;
  104.  
  105. begin
  106.   while keypressed do readkey;
  107.   repeat
  108.     select := random(3) + 1;
  109.     TriExt[4].x := TriExt[4].x + (TriExt[select].x - TriExt[4].x) div 2;
  110.     TriExt[4].y := TriExt[4].y + (TriExt[select].y - TriExt[4].y) div 2;
  111.     putpixel (TriExt[4].x, TriExt[4].y, 15);
  112.   until keypressed;
  113.   while keypressed do readkey;
  114. end;
  115.  
  116. begin
  117.   Randomize;
  118.   StartGraph;
  119.   RestoreCRTMode;
  120.   clrscr;
  121.   InputPoints;
  122.   SetGraphMode (GetGraphMode);
  123.   DrawChaos;
  124.   CloseGraph;
  125.   RestoreCRTMode;
  126.   clrscr;
  127. end.
  128.